parse arg args;options cache;options failat 99;options results;signal on break_c;signal on break_d;signal on break_e;signal on break_f;signal on halt;signal on ioerr;signal on syntax;address 'MAILMANAGER';Main:;call Init;call Header;call Parse_Args(strip(args));call Read_Cfg;call Wait_AreasWindow;call Command('c:delete >NIL:' system.tmpdir 'all quiet force noreq');if ~makedir(strip(system.tmpdir, 't', '/')) then call Quit(30, 'Unable to create tmpdir "'system.tmpdir'"!');if system.arg.arc then call Arc_Files;else call Unarc_Files;if exists(system.tmpdir) then call Command('c:delete >NIL:' system.tmpdir 'all quiet force noreq');call delete(system.tmpfile);call Quit(0, 'All done.');exit;Add_Arc: procedure Expose arc. system.;parse arg filename, del;MM_AddToStem 'arc.f.name' 'filename';MM_AddToStem 'arc.f.delete' 'del';return;Add_Flow: procedure Expose new. system.;parse arg file . 1 pfx 2 .;if system.sortflows then if pos(pfx, '-^#')>0 then stem = 'new.first';else stem = 'new.last';else stem = 'new'
MM_AddToStem stem 'file';return;Arc_FlowFiles: procedure Expose system.;arg address, flowname, arcname, type, archiver, extension;flow = flowname || type;full_flow = system.mm.outbound || flow;flow_tmp = full_flow'.tmp';test = system.arg.test;test.0 = '';test.1 = '.test';check = 0;if open(in, full_flow, a) then if rename(full_flow, flow_tmp) then check = 1;call close(in);if ~check then do;call Log(' *** WARNING: Unable to lock or rename "'full_flow'" to "'flow_tmp'"!');return;end;MM_ReadStem flow_tmp 'files';arc. = 0;new. = 0;do n=0 to files.count-1;check = left(files.n, 1);parse value upper(reverse(files.n)) with ext '.' .;ext = reverse(ext);select;when check='#' | ext='PKT' | index(system.bundle_exts, ext)>0 then call Add_Flow(files.n);when check='~' then iterate;otherwise;do;file = strip(files.n, 'l', '-^');force = Check_ForceArc(file);if force=0 then parse value statef(file)'0 0' with . size .;else size = 1;if size>0 & (force>0 | (size+512)%1024<system.maxfilesize) then call Add_Arc(file, force=2)
else call Add_Flow(files.n);end;end;end;if arc.f.name.count>0 then do;call Command('c:delete >NIL:' system.tmpdir'#? all quiet force noreq');do n=0 to arc.f.name.count-1;tmp = BaseName(arc.f.name.n);call Log(' -> Adding "'tmp'"',, 3);MM_CopyFile arc.f.name.n system.tmpdir || tmp;if RC~=0 then if ~exists(arc.f.name.n) then call Log(' *** WARNING: "'arc.f.name.n'" does not exist!');else;do;call Add_Flow(arc.f.name.n);call Log(' *** WARNING: Unable to copy "'arc.f.name.n'" to "'system.tmpdir'"!!!');end;end;old_cd = pragma('d', system.tmpdir);arc_file = system.mm.bundledir || arcname || extension;call Log(' => Arcing files to' arc_file'...');if Command(system.cmd.archiver.arc arc_file '#?', 1)=0 then do;tmp = 'To' address;MM_SetFilenote arc_file 'tmp';do n=0 to arc.f.name.count-1;if ~arc.f.delete.n then iterate;call Log(' -> Deleting "'arc.f.name.n'"',, 5);if ~test then if ~delete(arc.f.name.n) then call Log(' *** WARNING: Unable to delete "'arc.f.name.n'"!');end;if system.sortflows then stem = 'new.first'
else stem = 'new';ret. = 0;MM_SearchInStem stem 'ret' '"?'arc_file'"' 'NUM';if ret.count=0 then call Add_Flow('^'arc_file);call Write_Flow(flow_tmp || test.test);end;call Log(' Cleaning up...',, 5);call pragma('d', old_cd);call Command('c:delete >NIL:' system.tmpdir'#? all quiet force noreq');end;else call Log(' -> Nothing to do...',, 4);if ~rename(flow_tmp, full_flow) then call Quit(30, 'Unable to rename "'flow_tmp'" to "'full_flow'"!');return;Arc_Files: procedure Expose system.;call Log(' Reading index...',, 4);MM_ReadStem system.prg.idx 'system.idx';do n=0 to system.arc.node.count-1;parse var system.arc.node.n zone ':' net '/' nd '.' point '@' .;type = word('* C D F H', find('VIRTUAL CRASH DIRECT NORMAL HOLD', system.arc.flavor.n))'LO';flow = zone'.'net'.'nd'.'point'.';full_flow = system.mm.outbound || flow || type;call Log(' Checking flow "'flow || type'"...');parse value statef(full_flow)'0 0 0 0 0 0' with . size . . date time .;if size>0 then if Check_Flow(flow || type, size date time) then do
tmp = system.arc.arcer.n;call Arc_FlowFiles(system.arc.node.n, flow, system.arc.name.n'.', type, tmp, system.cmd.tmp.extension);end;else call Log(' -> No changes since last scan.',, 4);else call Log(' -> No flow found.',, 4);end;call Log(' Writing index...',, 4);MM_WriteStem system.prg.idx 'system.idx';if RC~=0 then call Quit(35, 'Unable to write "'system.prg.idx'"!!!');return;BaseName: procedure;parse arg file;p = max(lastpos(':', file), lastpos('/', file));if p=0 then ret = file;else ret = substr(file, p+1);return ret;break_c:; break_d:; break_e:; break_f:; halt:;signal off break_c;signal off break_d;signal off break_e;signal off break_f;signal off halt;return_code = 5;error_line = 0;error_msg = 'Execution halted!!!';rc = 0;signal Exit;Check_Flow: procedure Expose system.;arg flow, check;line = flow check;ret. = 0;MM_SearchInStem 'system.idx' 'ret' '"'flow' #?"' 'NUM';if ret.count=0 then do;MM_AddToStem 'system.idx' 'line';ret = 1;end;else;do;nr = ret.0;ret = system.idx.nr~=line;system.idx.nr = line;end
return ret;Check_ForceArc: procedure Expose system.;parse arg stem.0;stem.count = 1;do n=0 to system.forcearc.pattern.count-1;ret. = 0;MM_SearchInStem 'stem' 'ret' '"'system.forcearc.pattern.n'"' 'NUM';if ret.count>0 then return 1+(find(system.forcearc.delete, system.forcearc.pattern.n)>0);end;return 0;Command: procedure Expose system.;parse arg cmd, log;if log='' then log=5;address command cmd;if rc>log then call Log('*** ERROR: Command "'cmd'" returned' rc'.');return rc;Exit:;select;when return_code>=40 then error = 'INTERNAL-ERROR:';when return_code>=30 then error = 'IO-ERROR:';when return_code>=20 then error = 'ERROR:';when return_code>=10 then error = 'WARNING:';when return_code>=5 then error = 'INFO:';otherwise error = '';end;call Log();call Log('***' strip(error error_msg) '***', '+');call Log(,'\');call setclip('MM_LogPre', system.mm.logpre);exit return_code;Get_Arg: procedure Expose args cfg. system.;arg keyword, mode, old;uargs = upper(args);p = find(uargs, keyword);if p=0 then do
p = pos(' 'keyword'=', ' 'uargs);if p>0 then args = overlay(' ', args, p+length(keyword));p = find(upper(args), keyword);end;system.cmdopt.keyword = p>0;select;when mode=0 then if p>0 then do;ret = 1;args = delword(args, p, 1);end;else ret = old;when mode=1 then if p>0 then do;left = subword(args, 1, p-1);rest = subword(args, p+1);if left(rest, 1)='"' then parse var rest . '"' ret '"' rest;else parse var rest ret rest;args = strip(left strip(rest));end;else ret = old;when mode=2 then do;if left(args, 1)='"' then parse var args . '"' ret '"' args;else parse var args ret args;if strip(ret)='' then ret = old;end;otherwise exit 99;end;args = strip(args);ret = strip(ret, 'b', '" ');return ret;Get_Version: procedure;parse arg mode;parse value sourceline(3-mode) with . . ver .;parse var ver tst 'ß' .;if ~datatype(strip(tst, 'b', '/c '), 'N') then if ~mode then ver = Get_Version(1);else exit 99;return ver;Header:;call Log(,'/');call Log('***' system.prg.id '***', '+');call Log(' 'system.prg.cr);call Log();return
Init:;system. = 0;system.prg.ver = Get_Version(0);system.prg.name = 'MM_BundleFiles';system.prg.id = system.prg.name 'v'system.prg.ver;system.prg.cpfx = 'MM:Config/'system.prg.name'.';system.prg.cfg = system.prg.cpfx'cfg';system.prg.idx = system.prg.cpfx'idx';system.prg.script = 'MM:Rexx/'system.prg.name'.rexx';system.prg.cr = '(C) 1996 Robert Hofmann';system.tmpfile = 'T:'system.prg.name'.tmp';system.invalid = xrange('0'x, '@') || xrange('[', 'FF'x);system.replace = copies('_', length(system.invalid));system.mm.logpre = getclip('MM_LogPre');system.prg.logpre = system.mm.logpre'|';call setclip('MM_LogPre', system.prg.logpre);system.cmdopts = 'ARC/S,UNARC/S,CPLCFG/S,TEST/S';MM_GetCfgPaths 'system.mm';MM_Version 'system.mm';if system.mm.version<1.2 then call Quit(20, 'You need at least MM v1.2 to run this script!');call Include_Lib('rexxsupport');return;Include_Lib: procedure Expose system.;parse arg lib, prio;if right(upper(lib), 8)~='.LIBRARY' then lib = lib'.library';if prio='' then prio = 0
if ~show('l', lib) then if ~addlib(lib, prio, -30, 0) then call Quit(20, 'Could not open' lib'!!!');return;IOerr:;signal off ioerr;return_code = 20;error_line = sigl;error_msg = 'IO-error' rc 'at line' sigl '['errortext(rc)']');rc = 0;signal Exit;Log: procedure Expose system.;parse arg text, pre, level;if ~datatype(level, 'N') then level = system.prg.loglevel;tmp = word('PRG MM', (pre~='')+1);text = system.tmp.logpre || pre' 'text;MM_WriteLog 'text' level;return;Make_Valid: procedure Expose system.;arg string;return translate(string, system.replace, system.invalid);Parse_Args: procedure Expose system.;parse arg args;tpl = system.cmdopts',?/S';args = translate(args, ' ', '9'x'=');pk = pos('/K', tpl);ps = pos('/S', tpl);select;when pk=0 & ps=0 then p = 0;when pk=0 & ps>0 then p = ps;when ps=0 & pk>0 then p = pk;otherwise p = min(pk, ps);end;p = lastpos(',', left(tpl, p));tpl = substr(tpl, p+1) || left(tpl, max(p-1, 0));do while tpl~='';parse var tpl template ',' tpl;parse var template keyword '/' .
bool = pos('/S', template)>0;key = pos('/K', template)>0;must = pos('/A', template)>0;num = pos('/N', template)>0;select;when must then system.arg.keyword = '0'x;when bool then system.arg.keyword = 0;when num then system.arg.keyword = 0;otherwise system.arg.keyword = '';end;if bool | key then mode = ~bool;else mode = 2;system.arg.keyword = Get_Arg(keyword, mode, system.arg.keyword);if keyword='?' & system.arg.keyword=1 then leave;if must & system.arg.keyword='0'x then do;tmp = template 'missing!!!';say;say ' ***' tmp '***';signal Usage;end;if num & ~datatype(system.arg.keyword, 'N') then if ~must & system.arg.keyword='' then system.arg.keyword = 0;else;do;tmp = 'Numeric value expected for' template', but is "'system.arg.keyword'"!!!';say;say ' ***' tmp '***';signal Usage;end;end;tmp = '?'; if system.arg.tmp then signal Usage;if args~='' then call Quit(10, 'Unknown option(s):' args);if ~system.arg.arc & ~system.arg.unarc then call Quit(11, 'Too few arguments!')
if system.arg.arc & system.arg.unarc then call Quit(12, 'Too many arguments!');return;Path: procedure;parse arg path;tmp = right(path, 1);if tmp~='/' & tmp~=':' then path = path'/';return path;Quit:;parse arg return_code, error_msg;error_line = 0;rc = 0;signal Exit;Request_Choice: procedure Expose system.;parse arg text, buttons, ret_vals;title = system.prg.name'-Requester';text = translate(Replace(text, '0A'x, '\n'), '1b'x, '\');if length(text)<40 then text = center(text, 40);MM_Requester title 'text' 'buttons';if rc=0 then rc=words(ret_vals);return compress(word(ret_vals, rc), '_');Replace: procedure;parse arg string, new, old;do while index(string, old) ~= 0;interpret "parse var string l '"old"' r";string = l || new || r;end;return string;Syntax:;signal off syntax;return_code = 40;error_line = sigl;error_msg = 'Syntax-error' rc 'at line' sigl '['errortext(rc)']';rc = 0;signal Exit;Unarc_Files: procedure Expose system.;test = system.arg.test;call Log(' Searching for filebundles...')
call Command('c:list >'system.tmpfile system.mm.inbound 'p' system.unarc.pattern 'lformat "%n"');MM_ReadStem system.tmpfile 'found';if found.count=0 then call Log(' No filebundles found...');else;do;old_cd = pragma('d', system.tmpdir);do n=0 to found.count-1;call Log(' Unarcing' found.n'...');parse value upper(reverse(found.n)) with ext '.' basename;basename = reverse(basename);ext = reverse(ext);arcer = system.syn.ext;full_file = system.mm.inbound || found.n;ret = Command(system.cmd.arcer.unarc full_file)>0;if ret>0 then do;MM_CopyFile full_file system.mm.baddir'BAD_'found.n;call Log(' *** WARNING: Error' ret 'while unarcing "'found.n'", moved to "'system.mm.baddir'"!');end;else;if ~test then if system.backup then MM_MoveFile full_file system.mm.backupdir || found.n;else call delete(full_file);call Command('c:list >'system.tmpfile system.tmpdir'#? all files lformat "%p %n"');files. = 0;MM_ReadStem system.tmpfile 'files';do m=0 to files.count-1;parse var files.m dir name .;tmp = dir || name
call Log(' -> Extracted "'name'"',, 4);if test then iterate;MM_MoveFile tmp system.mm.inbound || name;if RC~=0 then call Quit(34, 'Unable to move "'tmp'" to "'system.mm.inbound'"!');end;end;call pragma('d', old_cd);call Command('c:delete' system.tmpdir'/#? all quiet force noreq');end;return;Usage:;rx. = '';rx.0.0 = '[rx] ';rx.0.1 = '[.rexx]';m = pos('/e', system.prg.ver)>0;say;say 'Usage:' rx.m.0 || system.prg.name || rx.m.1 system.cmdopts;say;call Quit(0, 'Usage requested.');Wait_AreasWindow: procedure Expose system.;MM_AreasWin;if rc=0 then return;bell = '07'x;cr = '0D'x;if Request_Choice('\c\n\1'system.prg.id'\0 is waiting.\n\nPlease go back to the Areas-Window as soon as possible!\n', '* _WAIT | _QUIT ', '0 1') then call Quit(5, 'Aborted by user.');tmp = 'Waiting for Areas-Window...';call writech(STDOUT, bell || tmp || cr);call Log(tmp,, 4);rc = 1;do while rc~=0;MM_AreasWin;call writech(STDOUT, bell);call Delay(250);end;return;Write_Flow: procedure Expose new. system.;parse arg flow
ps = pos('/S', tpl);select;when pk=0 & ps=0 then p = 0;when pk=0 & ps>0 then p = ps;when ps=0 & pk>0 then p = pk;otherwise p = min(pk, ps);end;p = lastpos(',', left(tpl, p));tpl = substr(tpl',', p+1) || left(tpl, max(p-1, 0));do while tpl~='';parse var tpl template ',' tpl;parse var template keyword '/' .;bool = pos('/S', template)>0;key = pos('/K', template)>0;must = pos('/A', template)>0;num = pos('/N', template)>0;select;when must then cfg.prm.keyword = '0'x;when bool then cfg.prm.keyword = 0;when num then cfg.prm.keyword = 0;otherwise cfg.prm.keyword = '';end;if bool | key then mode = ~bool;else mode = 2;cfg.prm.keyword = Get_Arg(keyword, mode, cfg.prm.keyword);if must & cfg.prm.keyword='0'x then call Quit(15, template 'for' cfgkey 'missing at line' l);if num & ~datatype(cfg.prm.keyword, 'N') then if ~must & cfg.prm.keyword='' then cfg.prm.keyword = 0;else call Quit(15, 'Numeric value expected for'cfgkey template' at line' l', but is "'cfg.prm.keyword'"!!!');end
if args~='' then call Quit(10, 'Unknown option(s) "'args'" for' cfgkey 'at line' l'!!!');return;Read_Cfg: procedure Expose system.;parse value statef(system.prg.script) with . size . . . . . version cfg_crc scr_crc;MM_CRCFile system.prg.cfg 'crc';if system.nocpl | x2c(version)=system.prg.ver & crc=cfg_crc & ~system.arg.cplcfg then do;MM_CRCFile system.prg.script 'crc';if system.nocpl | crc=scr_crc then do;call Log(' Reading config...');call Cfg;return;end;end;call Compile_Cfg;return
